home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / prog / memomous.arj / MEMOMOUS.PRG next >
Text File  |  1993-09-16  |  5KB  |  180 lines
  1. *Copyright 1993 Robert Greenlee, 72677,517, (619) 268-0112. Distribute Freely.
  2. *An example of a moused memoedit for Clipper 5.xx
  3. *Uses mouse primitives in Nanforum ToolKit v2.1.
  4. *Compile/Link: Clipper memomous.  Blinker fi memomous LIB NANFOR.
  5. *                               or RTLink fi memomous LIB NANFOR.
  6. #include "inkey.ch"
  7. #include "memoedit.ch"
  8. IF ! FT_MINIT()
  9.   ? "Can't run this mousey demo without a mouse!"
  10.   QUIT
  11. ENDI
  12. setcolor(IF(ISCOLOR(),'BG+/B','GR/N'))
  13. FT_MSETCOORD( maxrow(), 0 )
  14. IF !FILE("memomous.dbt")
  15.   aDbf :={{"Top","N",2,0},{"Bot","N",2,0},{"RCol","N",3,0},;
  16.           {"LCol","N",3,0},{"mText","M",0,0}} 
  17.   dbCreate("memomous",aDbf) ; USE memomous ALIAS my ; APPEND BLANK
  18.   my->Top := 1 ; my->Bot := maxrow()-1 ; my->RCol := maxcol()-1 
  19.   my->LCol := 1 ; cText := ''
  20.   FOR x = 1 TO 200 ; cText += LTRIM(STR(x,3))+CHR(13)+CHR(10) ; NEXT
  21.   my->mText := cText
  22. ENDI
  23. USE memomous ALIAS my
  24. SET KEY K_F1 TO funcF1
  25. cText := my->mText
  26. reedit := .t.
  27. DO WHIL reedit
  28.   cText := MEMOEDIT(cText,my->Top+1,my->LCol+2,my->Bot-1,my->RCol-1,.T.,;
  29.            "textFunc",my->RCol-my->LCol-3,5)
  30. ENDD
  31. CLEAR
  32. @ 24,0 SAY 'You just moused memoedit!  '
  33. IF ! LASTKEY() = K_ESC
  34.   my->mText := cText
  35.   ?? 'Your changes were saved.'
  36. ELSE
  37.   ?? 'No text changes made.'
  38. ENDI
  39. RETURN
  40.  
  41. FUNC textFunc(mode,LINE,COL)
  42. LOCAL keypress,retval,mtop,mbot,mfakekey,oldBot,oldRCol
  43. oldBot := my->Bot ; oldRCol := my->RCol
  44. mfakekey := K_CTRL_Z ; keypress := LASTKEY() ; retval := 0
  45. IF mode = ME_INIT
  46.   reedit := .f.
  47.   CLEAR
  48.   @ 0,2 SAY 'F1=Help'
  49.   @ 0,34 SAY 'MOUSEY MEMOEDIT'
  50.   @ 0,maxcol()-5 SAY 'PgUp'
  51.   @ maxrow(),maxcol()-5 SAY 'PgDn'
  52.   @ ROW(),2 SAY 'F10=Save   ESC=Undo'
  53.   @ my->Top,my->LCol TO my->Bot,my->RCol DOUBLE
  54. ELSEIF mode = ME_IDLE
  55.   nRow := ROW() ; nCol := COL() ; SetCursor(0)
  56.   @ maxrow(),34 SAY 'Line: '+PADR(LTRIM(STR(LINE)),4)
  57.   @ ROW(),45 SAY 'Col: '+PADR(LTRIM(STR(COL)),3)
  58.   @ nRow,nCol SAY '' ; SetCursor(1)
  59.   memomouse()
  60.   IF ! (oldBot = my->Bot .AND. oldRCol = my->RCol)  // redraw box
  61.     reedit := .t.
  62.     KEYBOARD CHR(K_CTRL_W)+CHR(mfakekey)
  63.   ENDI
  64. ELSE
  65.   IF keypress = mfakekey
  66.     memomouse()
  67.     IF ! (oldBot = my->Bot .AND. oldRCol = my->RCol)  // redraw box
  68.       reedit := .t.
  69.       KEYBOARD CHR(K_CTRL_W)+CHR(mfakekey)
  70.     ENDI
  71.   ENDI
  72.   IF keypress = K_F10
  73.     retval = K_CTRL_W
  74.   ENDI
  75.   IF NEXTKEY() = 0
  76.     KEYBOARD(CHR(mfakekey))
  77.   ENDI
  78. ENDI
  79. RETURN retval
  80.  
  81.  
  82. FUNCTION memomouse()
  83. LOCAL nX,nY,cK,key_blk,nKey
  84. FT_MCURSOR(.t.)  // mouse cursor on
  85. nKey := NEXTKEY()
  86. DO WHIL ! FT_MBUTPRS() = 0  // wait for button release from last time
  87. ENDD
  88. DO WHIL nKey = 0
  89.   nX := FT_MGETX() ; nY := FT_MGETY()
  90.   IF FT_MBUTPRS() = 2
  91.     my->Bot := nX
  92.     my->RCol := nY
  93.     DO WHIL FT_MBUTPRS() = 2  // wait for it to be released
  94.     ENDD
  95.     INKEY(.1)  // let it settle down
  96.     EXIT
  97.   ENDI
  98.   IF FT_MBUTPRS() = 1
  99.     IF nX == my->Top
  100.       KEYBOARD REPLI(CHR(K_UP),ROW()-my->Top)
  101.     ELSEIF nX < my->Top
  102.       KEYBOARD CHR(K_PGUP)
  103.     ELSEIF nX == my->Bot
  104.       KEYBOARD REPLI(CHR(K_DOWN),my->Bot-ROW())
  105.     ELSEIF nX > my->Bot
  106.       KEYBOARD CHR(K_PGDN)
  107.     ELSE
  108.       cK := ''
  109.       IF nX < ROW()
  110.         cK += REPLI(CHR(K_UP),ROW()-nX)
  111.       ELSEIF nX > ROW()
  112.         cK += REPLI(CHR(K_DOWN),nX-ROW())
  113.       ENDI
  114.       IF nY < COL()
  115.         cK += REPLI(CHR(K_LEFT),COL()-nY)
  116.       ELSEIF nY > COL()
  117.         cK += REPLI(CHR(K_RIGHT),nY-COL())
  118.       ENDI
  119.       IF !EMPTY(cK)
  120.         KEYBOARD cK
  121.       ENDI
  122.     ENDI
  123.   ENDI
  124.   nKey := NEXTKEY()  // don't let memoedit eval any setkey's
  125.   IF ! nKey = 0 .AND. (key_blk := setkey(nKey)) != Nil
  126.      INKEY()
  127.      FT_MCURSOR(.f.)  // mouse cursor off
  128.      EVAL(key_blk, procname(2), procline(2), "")
  129.      FT_MCURSOR(.t.)  // mouse cursor on
  130.      nKey := NEXTKEY()
  131.      LOOP
  132.   ENDI
  133. ENDD
  134. FT_MCURSOR(.f.)  // mouse cursor off
  135. RETURN Nil
  136.  
  137.  
  138. FUNCTION funcF1
  139. LOCAL oldF1,scr1,nRow,nCol
  140. oldF1 := SETKEY(K_F1,Nil)  // disable F1
  141. SAVE SCREEN TO scr1
  142. nRow := ROW() ; nCol := COL() ; SetCursor(0)
  143. CLEAR
  144. TEXT
  145.  
  146.                              -- The Help Screen --
  147.  
  148.    A SetKey Function (F1) has just been EVALed in the memoedit mouse handler
  149.    in order to prevent memoedit from gaining control.
  150.  
  151.    Using the mouse you can:
  152.  
  153.      * Position the cursor inside the memo box by pointing and clicking.
  154.  
  155.      * PgUp by clicking outside the memo box at the top.
  156.  
  157.      * PgDn by clicking outside the memo box at the bottom.
  158.  
  159.      * LineUp by clicking on the top line of the memo box.
  160.  
  161.      * LineDn by clicking on the bottom line of the memo box.
  162.  
  163.      * Resize the box by pointing and clicking with the right button.
  164.  
  165. ENDTEXT
  166. @ maxrow()-3,24 SAY '-- Touch any key or go Click --'
  167. @ maxrow()-1,2 SAY 'Copyright 1993 Robert Greenlee, 72677,517, (619)268-0112, Distribute Freely.'
  168. @ 0,0 TO maxrow(),maxcol() DOUBLE
  169. DO WHIL INKEY() + FT_MBUTPRS() = 0
  170. ENDD
  171. DO WHIL ! FT_MBUTPRS() = 0  // wait for button release
  172. ENDD
  173. INKEY(.1)  // wait for mouse button to settle down
  174. RESTORE SCREEN FROM scr1
  175. @ nRow,nCol SAY ''
  176. SetCursor(1)
  177. SETKEY(K_F1,oldF1)  // reenable F1
  178. RETURN Nil
  179.  
  180.